home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 1372.ZIP / PIBCAT.ARC / PIBCATZ.PAS < prev   
Pascal/Delphi Source File  |  1988-10-28  |  25KB  |  504 lines
  1. (*----------------------------------------------------------------------*)
  2. (*       Display_ZOO_Contents --- Display contents of .ZOO file         *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_ZOO_Contents( ZOOFileName : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Display_ZOO_Contents                                   *)
  10. (*                                                                      *)
  11. (*    Purpose:   Displays contents of a .ZOO file                       *)
  12. (*                                                                      *)
  13. (*    Calling sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Display_ZOO_Contents( ZOOFileName : AnyStr );                  *)
  16. (*                                                                      *)
  17. (*          ZOOFileName --- name of .ZOO file whose contents            *)
  18. (*                          are to be listed.                           *)
  19. (*                                                                      *)
  20. (*    Calls:                                                            *)
  21. (*                                                                      *)
  22. (*       Aside from internal subroutines, these routines are required:  *)
  23. (*                                                                      *)
  24. (*          Dir_Convert_Date_And_Time                                   *)
  25. (*                            --- convert DOS packed date/time to string*)
  26. (*          Open_File         --- open a file                           *)
  27. (*          Close_File        --- close a file                          *)
  28. (*          Entry_Matches     --- Perform wildcard match                *)
  29. (*          Display_Page_Titles                                         *)
  30. (*                            --- Display titles at top of page         *)
  31. (*          DUPL              --- Duplicate a character into a string   *)
  32. (*                                                                      *)
  33. (*----------------------------------------------------------------------*)
  34.  
  35. (*----------------------------------------------------------------------*)
  36. (*                  Maps of ZOO file headers and entries                *)
  37. (*----------------------------------------------------------------------*)
  38.  
  39. CONST
  40.    PATHSIZE   = 256                  (* Max length of pathname *);
  41.    FNAMESIZE  = 13                   (* Size of DOS filename   *);
  42.    LFNAMESIZE = 256                  (* Size of long filename  *);
  43.    SIZ_TEXT   = 20                   (* Length of header text  *);
  44.    Valid_ZOO  = $FDC4A7DC            (* Valid ZOO tag          *);
  45.    
  46. TYPE                               
  47.    Header_Text_Type = ARRAY[ 1 .. SIZ_TEXT   ] OF CHAR;
  48.    FName_Type       = ARRAY[ 1 .. FNAMESIZE  ] OF CHAR;
  49.    LFname_Type      = ARRAY[ 1 .. LFNAMESIZE ] OF CHAR;
  50.    Path_Type        = ARRAY[ 1 .. PATHSIZE   ] OF CHAR;
  51.  
  52.                                    (* ZOO file header *)
  53.    ZOO_Header_Type =  RECORD
  54.                          Header_Text : Header_Text_Type     (* Character text      *);
  55.                          ZOO_Tag     : LONGINT              (* Identifies archives *);
  56.                          ZOO_Start   : LONGINT              (* Where data starts   *);
  57.                          ZOO_Minus   : LONGINT              (* Consistency check   *);
  58.                          ZOO_Major   : CHAR                 (* Major version #     *);
  59.                          ZOO_Minor   : CHAR                 (* Minor version #     *);
  60.                       END;
  61.                                    (* One entry in ZOO library *)
  62.                                    (* Fixed part of entry      *)
  63.    ZOO_Fixed_Type  =  RECORD
  64.                                    (* Fixed part of entry *)
  65.                                    
  66.                          ZOO_Tag     : LONGINT              (* Tag -- redundancy check *);
  67.                          ZOO_Type    : BYTE                 (* Type of directory entry *);
  68.                          Pack_Method : BYTE                 (* 0 = no packing, 1 = normal LZW *);
  69.                          Next        : LONGINT              (* Pos'n of next directory entry *);
  70.                          Offset      : LONGINT              (* Position of this file *);
  71.                          Date        : WORD                 (* DOS format date *);
  72.                          Time        : WORD                 (* DOS format time *);
  73.                          File_CRC    : WORD                 (* CRC of this file *);
  74.                          Org_Size    : LONGINT              (* Original file size *);
  75.                          Size_Now    : LONGINT              (* Compressed file size *);
  76.                          Major_Ver   : BYTE                 (* Version required to extract ... *);
  77.                          Minor_Ver   : BYTE                 (* this file (minimum)             *);
  78.                          Deleted     : BYTE                 (* Will be 1 if deleted, 0 if not *);
  79.                          Struc       : BYTE                 (* File structure if any *);
  80.                          Comment     : LONGINT              (* Points to comment;  zero if none *);
  81.                          Cmt_Size    : WORD                 (* Length of comment, 0 if none *);
  82.                          FName       : FName_Type           (* Filename *);
  83.  
  84.                          Var_Dir_Len : INTEGER              (* Length of variable part of dir entry *);
  85.                          Time_Zone   : BYTE                 (* Time zone where file was created *);
  86.                          Dir_CRC     : WORD                 (* CRC of directory entry *);
  87.  
  88.                       END;
  89.  
  90.                                    (* Variable part of entry *)
  91.  
  92.    ZOO_Varying_Type = ARRAY[1..4+PATHSIZE+LFNAMESIZE] OF CHAR;
  93.  
  94.                                    (* Varying field definitions follow  *)
  95.                                    (* for descriptive purposes.  Any or *)
  96.                                    (* all of these can be missing,      *)
  97.                                    (* depending upon the setting of     *)
  98.                                    (* Var_Dir_Len above and NamLen and  *)
  99.                                    (* DirLen here.                      *)
  100.                                    
  101.  VAR
  102.     NamLen      : BYTE             (* Length of long filename  *);
  103.     DirLen      : BYTE             (* Length of directory name *);
  104.     LFName      : LFName_Type      (* Long filename            *);
  105.     DirName     : Path_Type        (* Directory name           *);
  106.     System_ID   : INTEGER          (* Filesystem ID            *);
  107.    
  108. VAR
  109.    ZOOFile       : FILE                 (* ZOO file to be read             *);
  110.    ZOO_Header    : ZOO_Header_Type      (* Header for ZOO file             *);
  111.    ZOO_Entry     : ZOO_Fixed_Type       (* Entry for one file in ZOO file  *);
  112.    ZOO_Varying   : ZOO_Varying_Type     (* Varying part of ZOO entry       *);
  113.    ZOO_Pos       : LONGINT              (* Current byte offset in ZOO file *);
  114.    Bytes_Read    : INTEGER              (* # bytes read from ZOO file      *);
  115.    Ierr          : INTEGER              (* Error flag                      *);
  116.    Do_Blank_Line : BOOLEAN              (* TRUE to print blank line        *);
  117.  
  118. (*----------------------------------------------------------------------*)
  119. (*        Get_ZOO_Header --- Get initial header entry in ZOO file       *)
  120. (*----------------------------------------------------------------------*)
  121.  
  122. FUNCTION Get_ZOO_Header( VAR Error : INTEGER ) : BOOLEAN;
  123.  
  124. (*----------------------------------------------------------------------*)
  125. (*                                                                      *)
  126. (*    Function:  Get_ZOO_Header                                         *)
  127. (*                                                                      *)
  128. (*    Purpose:   Gets initial ZOO header                                *)
  129. (*                                                                      *)
  130. (*    Calling sequence:                                                 *)
  131. (*                                                                      *)
  132. (*       OK := Get_ZOO_Header( VAR Error : INTEGER ) : BOOLEAN;         *)
  133. (*                                                                      *)
  134. (*          ZOOEntry --- Header data for next file in ZOO file          *)
  135. (*          Error    --- Error flag                                     *)
  136. (*          OK       --- TRUE if header successfully found, else FALSE  *)
  137. (*                                                                      *)
  138. (*----------------------------------------------------------------------*)
  139.  
  140. BEGIN (* Get_ZOO_Header *)
  141.                                    (* Assume no error to start *)
  142.    Error := 0;
  143.                                    (* Read in the file header entry. *)
  144.  
  145.    BlockRead( ZOOFile, ZOO_Header, SizeOf( ZOO_Header ), Bytes_Read );
  146.    Error := 0;
  147.                                    (* If we didn't read enough, assume     *)
  148.                                    (* it's not a ZOO file at all.          *)
  149.  
  150.    IF ( Bytes_Read <  SizeOf( ZOO_Header ) ) THEN
  151.       Error := Format_Error
  152.                                    (* Check signature.  If wrong, then    *)
  153.                                    (* file is bad or not an ZOO file at   *)
  154.                                    (* all.                                *)
  155.                                    
  156.    ELSE IF ( ZOO_Header.ZOO_Tag <> Valid_ZOO ) THEN
  157.       Error := Format_Error
  158.    ELSE                            (* Header looks ok -- we got    *)
  159.                                    (* the entry data.  Position to *)
  160.                                    (* first file entry             *)
  161.       WITH ZOO_Entry DO
  162.          ZOO_Pos := ZOO_Header.ZOO_Start;
  163.  
  164.                                     (* Report success/failure to calling *)
  165.                                     (* routine.                          *)
  166.  
  167.    Get_ZOO_Header := ( Error = 0 );
  168.  
  169. END   (* Get_ZOO_Header *);
  170.  
  171. (*----------------------------------------------------------------------*)
  172. (*        Get_Next_ZOO_Entry --- Get next file entry in ZOO file        *)
  173. (*----------------------------------------------------------------------*)
  174.  
  175. FUNCTION Get_Next_ZOO_Entry( VAR ZOOEntry : ZOO_Fixed_Type;
  176.                              VAR Error    : INTEGER ) : BOOLEAN;
  177.  
  178. (*----------------------------------------------------------------------*)
  179. (*                                                                      *)
  180. (*    Function:  Get_Next_ZOO_Entry                                     *)
  181. (*                                                                      *)
  182. (*    Purpose:   Gets header information for next file in ZOO file      *)
  183. (*                                                                      *)
  184. (*    Calling sequence:                                                 *)
  185. (*                                                                      *)
  186. (*       OK := Get_Next_ZOO_Entry( VAR ZOOEntry : ZOO_Fixed_Type;       *)
  187. (*                                 VAR Error    : INTEGER );            *)
  188. (*                                                                      *)
  189. (*          ZOOEntry --- Header data for next file in ZOO file          *)
  190. (*          Error    --- Error flag                                     *)
  191. (*          OK       --- TRUE if header successfully found, else FALSE  *)
  192. (*                                                                      *)
  193. (*----------------------------------------------------------------------*)
  194.  
  195. BEGIN (* Get_Next_ZOO_Entry *)
  196.                                    (* Assume no error to start *)
  197.    Error := 0;
  198.                                    (* Position to file entry   *)
  199.    Seek( ZOOFile, ZOO_Pos );
  200.                                    (* Read in the file header entry. *)
  201.  
  202.    BlockRead( ZOOFile, ZOO_Entry, SizeOf( ZOO_Entry ), Bytes_Read );
  203.    Error := 0;
  204.                                    (* If we didn't read enough, assume  *)
  205.                                    (* an error.                         *)
  206.  
  207.    IF ( Bytes_Read <  SizeOf( ZOO_Entry ) ) THEN
  208.       Error := Format_Error
  209.                                    (* Check signature.  If wrong, then    *)
  210.                                    (* file is bad or not an ZOO file at   *)
  211.                                    (* all.                                *)
  212.                                    
  213.    ELSE IF ( ZOO_Entry.ZOO_Tag <> Valid_ZOO ) THEN
  214.       Error := Format_Error
  215.    ELSE                            (* Header looks ok -- we got    *)
  216.                                    (* the entry data.  Position to *)
  217.                                    (* next header.                 *)
  218.       BEGIN
  219.          ZOO_Pos := ZOO_Entry.Next;
  220.          IF ( ZOO_Pos = 0 ) THEN
  221.             Error := End_Of_File;
  222.       END;   
  223.                                     (* Report success/failure to calling *)
  224.                                     (* routine.                          *)
  225.  
  226.    Get_Next_ZOO_Entry := ( Error = 0 );
  227.  
  228. END   (* Get_Next_ZOO_Entry *);
  229.  
  230. (*----------------------------------------------------------------------*)
  231. (*         Display_ZOO_Entry --- Display ZOO entry                      *)
  232. (*----------------------------------------------------------------------*)
  233.  
  234. PROCEDURE Display_ZOO_Entry( ZOO_Entry : ZOO_Fixed_Type );
  235.  
  236. VAR
  237.    SDate      : STRING[10];
  238.    STime      : STRING[12];
  239.    I          : INTEGER;
  240.    FileName   : AnyStr;
  241.    DirectName : AnyStr;
  242.    TimeDate   : LONGINT;
  243.    TimeDateW  : ARRAY[1..2] OF WORD ABSOLUTE TimeDate;
  244.    DelFile    : BOOLEAN;
  245.    
  246. BEGIN (* Display_ZOO_Entry *)
  247.  
  248.    WITH ZOO_Entry DO
  249.       BEGIN
  250.                                    (* Pick up file name *)
  251.  
  252.          FileName := COPY( FName, 1, PRED( POS( #0 , FName ) ) );
  253.  
  254.                                    (* See if this file matches the   *)
  255.                                    (* entry spec wildcard.  Exit if  *)
  256.                                    (* not.                           *)
  257.          IF Use_Entry_Spec THEN
  258.             IF ( NOT Entry_Matches( FileName ) ) THEN
  259.                EXIT;
  260.                                    (* Make sure room on current page *)
  261.                                    (* for this entry name.           *)
  262.                                    (* If enough room, print blank    *)
  263.                                    (* line if requested.  This will  *)
  264.                                    (* only happen for first file.    *)
  265.          IF Do_Blank_Line THEN
  266.             BEGIN
  267.                IF ( Lines_Left < 2 ) THEN
  268.                   Display_Page_Titles
  269.                ELSE
  270.                   BEGIN
  271.                      WRITELN( Output_File );
  272.                      DEC( Lines_left );
  273.                   END;
  274.                Do_Blank_Line := FALSE;
  275.             END
  276.          ELSE
  277.             IF ( Lines_Left < 1 ) THEN
  278.                Display_Page_Titles;
  279.  
  280.                                    (* Add '. ' to front if we're     *)
  281.                                    (* expanding ZOOs in main listing  *)
  282.          IF Expand_Libs_In THEN
  283.             FileName := '. ' + FileName;
  284.  
  285.                                    (* Get date and time of creation *)
  286.  
  287.          TimeDateW[1] := Time;
  288.          TimeDateW[2] := Date;
  289.  
  290.          Dir_Convert_Date_And_Time( TimeDate , SDate , STime );
  291.  
  292.                                    (* Write out file name, length, date, time *)
  293.  
  294.          WRITE( Output_File , Left_Margin_String, '      ' , FileName );
  295.  
  296.          FOR I := LENGTH( FileName ) TO 14 DO
  297.             WRITE( Output_File , ' ' );
  298.  
  299.          WRITE  ( Output_File , Org_Size:8, '  ' );
  300.          WRITE  ( Output_File , SDate, '  ' );
  301.          WRITE  ( Output_File , STime );
  302.  
  303.                                    (* Note if deleted entry *)
  304.  
  305.          DelFile := ( Deleted = 1 );
  306.  
  307.          IF ( DelFile ) THEN
  308.             WRITE( Output_File , '  (Deleted)' )
  309.          ELSE                      
  310.                                    (* Display long file name if requested *)
  311.                                    
  312.             IF ( Show_Long_File_Names AND ( Var_Dir_Len > 0 ) ) THEN
  313.                BEGIN
  314.                                    (* Read varying part *)
  315.  
  316.                   BlockRead( ZOOFile, ZOO_Varying, Var_Dir_Len, Bytes_Read );
  317.                                    
  318.                   IF ( Bytes_Read = Var_Dir_Len ) THEN
  319.                      BEGIN
  320.                                    (* Watch out -- assumes string[0] *)
  321.                                    (* contains length of string.     *)
  322.  
  323.                                    (* Get directory size and long file *)
  324.                                    (* name size.                       *)
  325.  
  326.                         NamLen := ORD( ZOO_Varying[ 1 ] );
  327.                         DirLen := ORD( ZOO_Varying[ 2 ] );
  328.  
  329.                                    (* Pick up system ID if we have one.   *)
  330.                                    (* Note MOVE used to extract data from *)
  331.                                    (* varying part of record here too.    *)
  332.                                    
  333.                         IF ( ( NamLen + DirLen + 2 ) < Var_Dir_Len ) THEN
  334.                            MOVE( ZOO_Varying[ NamLen + DirLen + 3 ], System_ID, 2 )
  335.                         ELSE
  336.                            System_ID := 4095;     
  337.                            
  338.                                    (* Skip this stuff if we have neither. *)
  339.  
  340.                         IF ( ( DirLen > 0 ) OR ( NamLen > 0 ) ) THEN
  341.                            BEGIN
  342.  
  343.                                    (* Get long name.  If none, just   *)
  344.                                    (* use short name again.  Note --  *)
  345.                                    (* we get 1 less than specified    *)
  346.                                    (* length, since directory and     *)
  347.                                    (* names are stored with trailing  *)
  348.                                    (* #0 = ascii Z string format.     *)
  349.  
  350.                               IF ( NamLen > 0 ) THEN
  351.                                  BEGIN
  352.                                     MOVE( ZOO_Varying[ 3 ] , FileName[ 1 ] , PRED( NamLen ) );
  353.                                     FileName[ 0 ] := CHR( PRED( NamLen ) );
  354.                                  END
  355.                               ELSE
  356.                                  FileName := COPY( FName, 1, PRED( POS( #0 , FName ) ) );
  357.  
  358.                                    (* Get directory name *)
  359.  
  360.                               IF ( DirLen > 0 ) THEN
  361.                                  BEGIN
  362.  
  363.                                     MOVE( ZOO_Varying[ 3 + NamLen ] , DirectName[ 1 ] , PRED( DirLen ) );
  364.                                     DirectName[ 0 ] := CHR( PRED( DirLen ) );
  365.  
  366.                                    (* Append trailing '/' if missing and *)
  367.                                    (* system ID indicates we should      *)
  368.  
  369.                                     IF ( System_ID <= 2 ) THEN
  370.                                        IF ( DirectName[ LENGTH( DirectName ) ] <> '/' ) THEN
  371.                                           DirectName := DirectName + '/';
  372.  
  373.                                  END
  374.                               ELSE
  375.                                  DirectName := '';
  376.                                     
  377.                                    (* Write directory and file name *)
  378.                                    
  379.                               WRITE( Output_File , '  ' , DirectName , 
  380.                                      FileName );
  381.  
  382.                            END;
  383.  
  384.                      END;
  385.  
  386.                   END;
  387.                                    (* End output line *)
  388.          WRITELN( Output_File );
  389.  
  390.                                    (* Count lines left on page *)
  391.          IF Do_Printer_Format THEN
  392.             DEC( Lines_Left );
  393.  
  394.                                    (* Increment file count, total bytes *)
  395.                                    (* if file not a deleted entry.      *)
  396.          IF ( NOT DelFile ) THEN
  397.             BEGIN
  398.                                    (* Increment total space used  *)
  399.  
  400.                Total_ESpace := Total_ESpace + Org_Size;
  401.  
  402.                                    (* Increment total entry count *)
  403.  
  404.                INC( Total_Entries );
  405.  
  406.             END;   
  407.  
  408.       END;
  409.  
  410. END (* Display_ZOO_Entry *);
  411.  
  412. (*----------------------------------------------------------------------*)
  413.  
  414. BEGIN (* Display_ZOO_Contents *)
  415.  
  416.                                    (* Set left margin spacing *)
  417.  
  418.    Left_Margin_String := Left_Margin_String + DUPL( ' ' , Library_Indent );
  419.  
  420.                                    (* Set file title *)
  421.  
  422.    File_Title := Left_Margin_String + ' ZOO file: ' + ZOOFileName;
  423.  
  424.                                    (* Display ZOO file's name *)
  425.    IF Do_Printer_Format THEN
  426.       IF ( Lines_Left < 3 ) THEN
  427.          Display_Page_Titles;
  428.                                    (* If we're listing contents at end  *)
  429.                                    (* of directory, print ZOO file name. *)
  430.                                    (* Do_Blank_Line flags whether we    *)
  431.                                    (* need to print blank line in entry *)
  432.                                    (* lister subroutine.  If listing    *)
  433.                                    (* inline, then it's true for the    *)
  434.                                    (* first file; otherwise it's false. *)
  435.                                    (* This is to prevent unnecessary    *)
  436.                                    (* blank lines in output listing     *)
  437.                                    (* when no files are selected from   *)
  438.                                    (* a given ZOO file.                  *)
  439.    IF ( NOT Expand_Libs_In ) THEN
  440.       BEGIN
  441.          WRITELN( Output_File ) ;
  442.          WRITE  ( Output_File , File_Title );
  443.          DEC( Lines_Left , 2 );
  444.          Do_Blank_Line := FALSE;
  445.       END
  446.    ELSE
  447.       Do_Blank_Line := TRUE;
  448.                                    (* Try opening ZOO file for processing *)
  449.  
  450.    Open_File( ZOOFileName , ZOOFile, ZOO_Pos, Ierr );
  451.  
  452.                                    (* Issue error message if open fails *)
  453.    IF ( Ierr <> 0 ) THEN
  454.       BEGIN
  455.          WRITELN( Output_File ,
  456.                   DUPL( ' ' , MAX( 0 , MIN( 12 , 13 - LENGTH( ZOOFileName ) ) ) ),
  457.                   '     Can''t open .ZOO file ',ZOOFileName );
  458.          IF Do_Printer_Format THEN
  459.             BEGIN
  460.                DEC( Lines_Left );
  461.                IF ( Lines_Left < 1 ) THEN
  462.                   Display_Page_Titles;
  463.             END;
  464.          EXIT;
  465.       END
  466.    ELSE IF ( NOT Expand_Libs_In ) THEN
  467.       BEGIN
  468.  
  469.          WRITELN( Output_File );
  470.          WRITELN( Output_File );
  471.                                    (* Count lines left on page *)
  472.          IF Do_Printer_Format THEN
  473.             DEC( Lines_Left );
  474.  
  475.       END;
  476.                                    (* Loop over entries in ZOO file *)
  477.  
  478.    IF Get_ZOO_Header( Ierr ) THEN
  479.       WHILE( Get_Next_ZOO_Entry( ZOO_Entry , Ierr ) ) DO
  480.          Display_ZOO_Entry( ZOO_Entry );
  481.  
  482.                                    (* Print blank line after last entry   *)
  483.                                    (* in ZOO file, if we're expanding      *)
  484.                                    (* ZOO files right after listing them,  *)
  485.                                    (* but only if ZOO file had any entries *)
  486.                                    (* listed.                             *)
  487.  
  488.    IF ( Expand_Libs_In AND ( NOT Do_Blank_Line ) ) THEN
  489.       BEGIN
  490.          WRITELN( Output_File );
  491.          IF Do_Printer_Format THEN
  492.             DEC( Lines_Left );
  493.       END;
  494.                                    (* Close ZOO file *)
  495.    Close_File( ZOOFile );
  496.                                    (* Restore previous left margin spacing *)
  497.  
  498.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  499.  
  500.                                    (* No file title *)
  501.    File_Title := '';
  502.  
  503. END   (* Display_ZOO_Contents *);
  504.